home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Pascal Super Library
/
Pascal Super Library (CW International)(1997).bin
/
LIBRARY
/
PASDEMO2
/
P571.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1987-09-28
|
4KB
|
139 lines
program TaskList;
{This program maintains a list of tasks}
const Max = 20; { Length of task names }
type ListData = array [1..Max] of char;
ListPointer = ^Item;
Item = record Data: ListData;
Nest: ListPointer
end;
var NullChar: char; { the null character, ch(0) }
procedure Initialization( var First: ListPointer );
{This procedure initializes all appropriate variables }
begin
First := Nil;
NullChar := char(0)
end;
procedure ReadData( var Name: ListData );
{This procedure reads a name from the terminal }
var Index: integer;
begin
Index := 1;
while (Index <= Max ) and Not Eoln
do begin
read( Name[Index] );
Index := Index + 1;
end;
readln;
while (Index <= Max )
do begin
Name[Index] := NullChar;
Index := Index + 1;
end;
end;
procedure FindPrevious( Name: ListData; var PrevElt: ListPointer;
First: LIstPointer );
{This procedure locates the task that comes before given name on the list.
If the name is not found, PreElt^.Next will be Nil.
The procedure assumes the Name is not the first list element. }
var ListElt: ListPointer; {This pointer gives the list item
where the Name is checked }
function Done: boolean;
{This function determines if more items must be searched on the list }
begin
if ListElt = Nil
then Done := true
else Done := ( Name = ListElt^.Data );
end;
begin
PrevElt := First;
ListElt := PrevElt^.Data;
while not Done
do begin
PrevElt := ListElt;
ListElt := PrevElt^.Next
end;
end;
procedure AddName( var First: ListPointer );
{this procedure reads a task name and inserts it into the list}
var NewItem: ListPointer;
OldItem: ListData;
procedure InsertFirst( NewItem: ListPointer; var First: ListPointer );
{this procedure inserts the new item at the beginning of the list}
begin
NewItem^.Next := First;
First := NewItem
end;
procedure InsertAfterFirst( NewItem, First: ListPointer );
{this procedure inserts the new item after the start of the list }
var PrevElt: ListPointer;
begin
FindPrevious( OldName, PreElt, First );
NewItem^.Next := PrevElt^.Next;
PrevElt^.Next := NewItem
end;
begin
New( NewItem );
write( 'Enter new task' );
readData( NewItem^.Data );
if First = Nil
then InsertFirst( NewItem, First )
else begin
writeln( 'Enter old task which new task should preceed, ' );
write( 'or enter a blank if new task should be ',
'placed "last": ' );
readData( OldName );
if OldName = First^.Data
then InsertFirst( NewItem, First )
else InsertAfterFirst( NewItem, First );
end
end;
procedure DeletionName( var First: Listpointer );
{this procedure reads a task name and deletes the name from the list }
var Name: ListData;
procedure DeleteName( Name: ListData; var First: ListPointer );
var PrevElt, ListElt: ListPointer;
begin
if First^.Data = Name
then begin {delete first element on list }
ListElt := First;
First := ListElt^.Next;
Dispose( ListElt );
end
else begin
FindPrevious( Name, PrevElt, First );
if ListElt = Nil
then writeln( 'Task not found on list' );
else begin
PrevElt^.Next := ListElt^.Next;
Dispose( ListElt )
end
end
end;
begin
if First = Nil
then weiteln( 'List in empty - no deletions are possible' )
else begin
write( 'Enter task name to be deleted: ' );
ReadData( Name );
DeleteName( Name, First );;
endl
end;
procedure Print( First: ListPointer );;
{this procedure prints the current data items on the list }
var ListElt: ListPointer;
begin
writeln( 'The list of tasks are: ' );
writeln;
ListElt